home *** CD-ROM | disk | FTP | other *** search
/ Almathera Ten Pack 2: CDPD 1 / Almathera Ten on Ten - Disc 2: CDPD 1.iso / pd / 101-125 / 118 / hammmm / mmm_sound < prev    next >
Text File  |  1995-03-13  |  2KB  |  104 lines
  1. \ Play a just intoned chord that responds to the
  2. \ graphic activity.  The waveform will be set
  3. \ to the Y values of the points.  The pitch will be
  4. \ set to the average x position.
  5. \
  6. \ The DA.xxx words can be found in HMSL which
  7. \ is a music language written Phil Burk, Larry Polansky,
  8. \ and David Rosenboom at the Mills College Center for
  9. \ Contemporary music.  A set of stubs are provided
  10. \ for JForth users who do not have HMSL.
  11. \
  12. \ Author: Phil Burk
  13. \ Copyright 1987 Phil Burk
  14. \ This code is considered to be in the public domain and
  15. \ may be freely distributed but may not be sold for profit.
  16.  
  17. ANEW TASK-MMM_SOUND
  18.  
  19. variable WAVEFORM-1
  20. 16 constant WAVELENGTH
  21.  
  22. : ALLOC.WAVE  ( -- , allocate CHIP RAM for waveform )
  23.     MEMF_CHIP wavelength allocblock ?dup
  24.     IF waveform-1 !
  25.     ELSE ." Couldn't allocate waveform." cr
  26.          abort
  27.     THEN
  28. ;
  29.  
  30. : FREE.WAVE ( -- )
  31.     waveform-1 @ freeblock
  32. ;
  33.  
  34. : CHANGE.TIMBRE  ( -- , copy y positions )
  35.     ham_num_points wavelength min 0
  36.     DO  120 i ham-y-pos @ -
  37.         waveform-1 @ i + c!
  38.     LOOP
  39. ;
  40.  
  41. \ Use ratiometric tuning to get chord.
  42. CREATE CHORD-DENOMS 1 , 2 , 4 , 7 ,
  43. CREATE CHORD-NUMERS 1 , 3 , 5 , 12 ,
  44.  
  45. : SET.WAVEFORMS ( -- , use same waveform on all four channels )
  46.     4 0
  47.     DO  i da.channel!
  48.         waveform-1 @ wavelength da.sample!
  49.     LOOP
  50. ;
  51.  
  52. : START.SOUND ( -- , start all four channels sounding )
  53.     4 0
  54.     DO  i da.channel!
  55.         da.start
  56.     LOOP
  57. ;
  58.  
  59. : SET.PITCH ( period -- , play chord )
  60.     4 0
  61.     DO  i da.channel!
  62.         dup i cells chord-numers + @
  63.         i cells chord-denoms + @ */
  64.         da.period!
  65.         da.start
  66.     LOOP drop
  67. ;
  68.  
  69. : AVERAGE.X.POS ( -- x , calculate it )
  70.     0 ham_num_points 0
  71.     DO i ham-x-pos @ +
  72.     LOOP
  73.     ham_num_points /
  74. ;
  75.  
  76. : CHANGE.PITCH ( -- , set pitch to average x )
  77.     average.x.pos
  78.     4 * 500 +
  79.     set.pitch
  80. ;
  81.  
  82. : CHANGE.SOUND ( -- , make all changes )
  83.     change.timbre
  84.     change.pitch
  85. ;
  86.  
  87. : STOP.SOUND ( -- )
  88.     da.kill
  89. ;
  90.  
  91. : SOUND.INIT ( -- )
  92.     da.init
  93.     alloc.wave
  94.     set.waveforms
  95.     change.sound
  96.     start.sound
  97. ;
  98.  
  99. : SOUND.TERM ( -- )
  100.     stop.sound
  101.     free.wave
  102.     da.term
  103. ;
  104.